* Поиск пути на графе
* Программа КОНЦЕПТ, 22.12.2010, www.gendoc.ru

* Начало программы

присвоить ШИРИНА_МАКС 8 ВЫСОТА_МАКС 8
присвоить ШАГ_РЕШЕТКИ 60 
присвоить ЦВЕТ_ВЕРШИНЫ 14 РАДИУС_ВЕРШИНЫ 20 
присвоить ЦВЕТ_РЕБРА 4 ЦВЕТ_ВЕРШИНЫ_ВЫД 10

Сгенерить_граф
Найти_путь
Показать_граф

* Функции 

функция Сгенерить_граф
  память локальный ширина список_высота список_высота_выбраны выбран \
    предыдущая_вершина список_высота_выбраны_пред ширина_пред выбран1 выбран2

  факт добавить s;вершина;обозначение_вершины s;ребро;обозначение_вершины_1;обозначение_вершины_2

  присвоить ширина_пред '' список_высота_выбраны_пред {}
  для ширина (список сгенерить $результат 1 [ШИРИНА_МАКС] )
    список сгенерить список_высота 1 [ВЫСОТА_МАКС]
    присвоить список_высота_выбраны {}

* Формирование списка случайно выбранных вершин для заданной ширины
    для (список сгенерить $результат 1 (список выбратьСлучайный $результат [список_высота] ) )
      список выбратьСлучайный выбран [список_высота]
      список сцепить список_высота_выбраны $ [выбран]
      множество разность список_высота $ [выбран]
    следующий

* Формирование фактов о вершинах и ребрах для заданной ширины
    список упорядочитьЧисла список_высота_выбраны $
    присвоить предыдущая_вершина ''
    для [список_высота_выбраны]
      факт добавить "r;вершина;{[ширина];[$ОбъектЦикла]}"     
      если [предыдущая_вершина] != ''
        факт добавить "r;ребро;[предыдущая_вершина];{[ширина];[$ОбъектЦикла]}"
      конец
      присвоить предыдущая_вершина "{[ширина];[$ОбъектЦикла]}"
    следующий

* Формирование ребра, связывающего вершины из двух соседних колонок (ширин)
    если [список_высота_выбраны_пред]
      список выбратьСлучайный выбран1 [список_высота_выбраны_пред]  
      список выбратьСлучайный выбран2 [список_высота_выбраны]  
      факт добавить "r;ребро;{[ширина_пред];[выбран1]};{[ширина];[выбран2]}"
    конец

    присвоить ширина_пред [ширина] список_высота_выбраны_пред [список_высота_выбраны] 
    если [ширина] == 1
      список выбратьСлучайный выбран [список_высота_выбраны]
      присвоить НАЧАЛЬНАЯ_ВЕРШИНА "[ширина];[выбран]"
    конец
    если [ширина] == [ШИРИНА_МАКС]
      список выбратьСлучайный выбран [список_высота_выбраны]
      присвоить КОНЕЧНАЯ_ВЕРШИНА "[ширина];[выбран]"
    конец
  следующий
*показать данные
*отладка
возврат

функция Найти_путь
  память локальный ПРОСМОТРЕТЬ ПРОСМОТРЕНЫ ТЕКУЩАЯ_ВЕРШИНА СМЕЖНЫЕ_ВЕРШИНЫ \
     родители_ПРОСМОТРЕТЬ родители_ПРОСМОТРЕНЫ родитель_ТЕКУЩАЯ_ВЕРШИНА \
     позиция вершина

  >Демонстрация алгоритма поиска пути на графе.
  >Задача: Найти путь от вершины {[НАЧАЛЬНАЯ_ВЕРШИНА]} до {[КОНЕЧНАЯ_ВЕРШИНА]}.

  присвоить НАЙДЕН_ПУТЬ {}
  присвоить ПРОСМОТРЕТЬ "{[НАЧАЛЬНАЯ_ВЕРШИНА]}" ПРОСМОТРЕНЫ {} 
  присвоить  родитель_ТЕКУЩАЯ_ВЕРШИНА {} родители_ПРОСМОТРЕТЬ "{[родитель_ТЕКУЩАЯ_ВЕРШИНА]}" родители_ПРОСМОТРЕНЫ {}
  пока [ПРОСМОТРЕТЬ] != {}
    список голова ТЕКУЩАЯ_ВЕРШИНА [ПРОСМОТРЕТЬ]
    список голова родитель_ТЕКУЩАЯ_ВЕРШИНА [родители_ПРОСМОТРЕТЬ]
    список удалить ПРОСМОТРЕТЬ $ 1 1
    список удалить родители_ПРОСМОТРЕТЬ $ 1 1
    если [ТЕКУЩАЯ_ВЕРШИНА] == [КОНЕЧНАЯ_ВЕРШИНА]
      присвоить НАЙДЕН_ПУТЬ "{[ТЕКУЩАЯ_ВЕРШИНА]}"
      пока [родитель_ТЕКУЩАЯ_ВЕРШИНА] != {}
        список сцепить НАЙДЕН_ПУТЬ $ "{[родитель_ТЕКУЩАЯ_ВЕРШИНА]}"
        список найти позиция [ПРОСМОТРЕНЫ] [родитель_ТЕКУЩАЯ_ВЕРШИНА]
        список взять родитель_ТЕКУЩАЯ_ВЕРШИНА [родители_ПРОСМОТРЕНЫ] [позиция]
      цикл      
      список инвертировать НАЙДЕН_ПУТЬ $
      присвоить ПРОСМОТРЕТЬ {}
      >Решение: [НАЙДЕН_ПУТЬ].
    иначе
    * Сформировать множество смежных вершин
      множество или СМЕЖНЫЕ_ВЕРШИНЫ \
        (факт сопоставитьМножество $результат "r;ребро;{[ТЕКУЩАЯ_ВЕРШИНА]};[?смежные]" ) \
        (факт сопоставитьМножество $результат "r;ребро;[?смежные];{[ТЕКУЩАЯ_ВЕРШИНА]}" )
      список сцепить ПРОСМОТРЕНЫ $ "{[ТЕКУЩАЯ_ВЕРШИНА]}"
      список сцепить родители_ПРОСМОТРЕНЫ $ "{[родитель_ТЕКУЩАЯ_ВЕРШИНА]}"
      для [СМЕЖНЫЕ_ВЕРШИНЫ]
        если (список найти $результат [ПРОСМОТРЕТЬ] [$ОбъектЦикла] ) 
        иначе
          если (список найти $результат [ПРОСМОТРЕНЫ] [$ОбъектЦикла] ) 
          иначе
            список сцепить ПРОСМОТРЕТЬ $ "{[$ОбъектЦикла]}"
            список сцепить родители_ПРОСМОТРЕТЬ $ "{[ТЕКУЩАЯ_ВЕРШИНА]}"
          конец 
        конец
      следующий
    конец
  цикл
возврат

функция Показать_граф
  память локальный номер_факта Вершина1 Вершина2

* Рисование ребер графа
  присвоить $цветЛинии [ЦВЕТ_РЕБРА] $толщинаЛинии 1
  присвоить номер_факта 1
  пока [номер_факта] <= [$КоличествоФактов]
    если (список сопоставить $результат (факт взять $результат [номер_факта] ) "r;ребро;[?Вершина1];[?Вершина2]" )
      Рисовать_линию [Вершина1] [Вершина2]
    конец
    увеличить номер_факта
  цикл

* Рисование найденного пути
  присвоить $цветЛинии [ЦВЕТ_ВЕРШИНЫ_ВЫД] $толщинаЛинии 5
  для [НАЙДЕН_ПУТЬ]
    если (список размер $результат [$СписокЦикла] ) > 0
      Рисовать_линию [$ОбъектЦикла] (список голова $результат [$СписокЦикла] )
    конец
  следующий

* Рисование вершин графа
  присвоить $цветЛинии [ЦВЕТ_ВЕРШИНЫ] $цветКисти [ЦВЕТ_ВЕРШИНЫ]
  для (факт домен $результат вершина обозначение_вершины )
      Рисовать_вершину [$ОбъектЦикла]
  следующий

* Рисование крайних точек искомого пути
  присвоить $цветЛинии [ЦВЕТ_ВЕРШИНЫ_ВЫД] $цветКисти [ЦВЕТ_ВЕРШИНЫ_ВЫД]
  Рисовать_вершину [НАЧАЛЬНАЯ_ВЕРШИНА]
  Рисовать_вершину [КОНЕЧНАЯ_ВЕРШИНА]
возврат

функция Рисовать_вершину вершина
  память локальный ширина высота ширина0 высота0 ширина1 высота1 ширина2 высота2
  список сопоставить _ [вершина] "[?ширина];[?высота]"
  вычислить * ширина0 [ширина] [ШАГ_РЕШЕТКИ]
  вычислить * высота0 [высота] [ШАГ_РЕШЕТКИ]
  вычислить - ширина1 [ширина0] [РАДИУС_ВЕРШИНЫ]
  вычислить - высота1 [высота0] [РАДИУС_ВЕРШИНЫ]
  вычислить + ширина2 [ширина0] [РАДИУС_ВЕРШИНЫ]
  вычислить + высота2 [высота0] [РАДИУС_ВЕРШИНЫ]  
  рисовать круг [ширина1] [высота1] [ширина2] [высота2]
  рисовать текстВПрямоугольнике [ширина1] [высота1] [ширина2] [высота2] "{[ширина];[высота]}"
возврат

функция Рисовать_линию вершина1 вершина2
  память локальный ширина1 высота1 ширина2 высота2
  список сопоставить _ [вершина1] "[?ширина1];[?высота1]"
  список сопоставить _ [вершина2] "[?ширина2];[?высота2]"
  вычислить * ширина1 $ [ШАГ_РЕШЕТКИ]
  вычислить * высота1 $ [ШАГ_РЕШЕТКИ]
  вычислить * ширина2 $ [ШАГ_РЕШЕТКИ]
  вычислить * высота2 $ [ШАГ_РЕШЕТКИ]
  рисовать линия [ширина1] [высота1] [ширина2] [высота2]
возврат